home *** CD-ROM | disk | FTP | other *** search
/ Aminet 23 / Aminet 23 (1998)(GTI - Schatztruhe)[!][Feb 1998].iso / Aminet / text / edit / Smartindent.lha / Smartindent / Source / semantics_lisp.c < prev    next >
C/C++ Source or Header  |  1997-12-14  |  5KB  |  338 lines
  1. /*(( "Kopf" */
  2. /* -----------------------------------------------------------------------------
  3.  
  4.    $Id: semantics_c.c,v 1.5 1997/07/17 00:24:10 mshopf Exp mshopf $
  5.  
  6.    GoldED API client, ©1995 Matthias Hopf.
  7.    Compiled with SasC.
  8.  
  9.    Lisp style semantics parser
  10.  
  11.    ------------------------------------------------------------------------------
  12. */
  13.  
  14. /*)) */
  15. #include "semantics.h"
  16.  
  17. /*(( "Private prototypes" */
  18.  
  19. FUNC (OUTSIDEBLOCK);
  20. FUNC (BLOCK);
  21. FUNC (COMMENT);
  22. FUNC (STRING_DOUBLE);
  23. FUNC (STRING_SINGLE);
  24.  
  25. /*)) */
  26. /*(( "Indent_Lisp ()" */
  27.  
  28. /****** Main routine ******/
  29. void    Indent_Lisp (sc_t *c)
  30. {
  31.     OUTSIDEBLOCK (c, 0);
  32.     if (c->CurrentLine <= c->EndIndent)
  33.     Error (c, UNMATCHED_BRACE_ERROR);
  34.     debug (Dbug, ("\n\n"));             // Do it always...
  35. }
  36.  
  37. /*)) */
  38. /*(( "IsWord_Lisp ()" */
  39.  
  40. int IsWord_Lisp (sc_t *c, char *buf, int len, int maxlen)
  41. {
  42.     char *t;
  43.  
  44.     switch (len) {
  45.     case 0:
  46.     return MATCH_TRUE;
  47.  
  48.     case 1:
  49.     switch (buf [0]) {
  50.     case ';':
  51.     case '\'':
  52.     case '"':
  53.     case '(':
  54.     case ')':
  55.     case '\\':
  56.         return MATCH_EXACT;
  57.     }
  58.     return MATCH_TRUE;
  59.     }
  60.  
  61.     for (t = buf+1; t < & buf [len]; t++)
  62.     if (*t == '\0' || *t == ' ' || *t == '\t' || *t == ';' ||
  63.         *t == '('  || *t == ')' || *t == '"'  || *t == '\'' || *t == '\\')
  64.         return MATCH_FALSE;
  65.  
  66.     return MATCH_TRUE;
  67. }
  68.  
  69.  
  70. /*)) */
  71. /*(( "KeyPress_Lisp ()" */
  72.  
  73. void KeyPress_Lisp (sc_t *c, int key)
  74. {
  75.     int Line   = c->Edit->Line;
  76.     int StartLine = -1, EndLine = -1;
  77.  
  78.     switch (key) {
  79.  
  80.     case ';':
  81.     StartLine = EndLine = Line;
  82.     break;
  83.  
  84.     case '(':
  85.     case ')':
  86.     StartLine = EndLine = Line;
  87.     break;
  88.  
  89.     case '\n':
  90.     case '\15':
  91.     StartLine = Line > 0 ? Line-1 : 0;
  92.     EndLine   = Line;
  93.     }
  94.  
  95.     if (StartLine >= 0)
  96.     {
  97.     InitIndent (c, StartLine, EndLine, MODE_LINE | MODE_CURSOR);
  98.     Indent_Lisp (c);
  99.     CleanupIndent (c);
  100.     }
  101. }
  102.  
  103.  
  104. /*)) */
  105. /*(( "Semantics structure" */
  106.  
  107. /****** Method structure ******/
  108. struct Semantic Lisp_Sem =
  109. {
  110.     "Lisp",
  111.     "Lisp semantics parser",
  112.     "V0.1 ©1995 Matthias Hopf",
  113.     IsWord_Lisp,
  114.     KeyPress_Lisp,
  115.     Indent_Lisp,
  116.     { 1, 9, 9, 9, 1, 4, 40 }            /* 9: not used here*/
  117. } ;
  118.  
  119. /*)) */
  120. /*(( "Parser specific errors" */
  121.  
  122. static const char *FUNCTION_AFTER_BRACE_EXPECTED_ERROR = "Expecting function invocation after brace in line %ld";
  123.  
  124. /*))*/
  125.  
  126. /*(( "OUTSIDEBLOCK ()" */
  127.  
  128. FUNC (OUTSIDEBLOCK)
  129. {
  130.     debug (D_PARSER, ("OUTSIDEBLOCK(%ld)\t", I));
  131.     dcheck;
  132.  
  133.     DOGET
  134.     {
  135.     switch (W[0]) {                 // no test for length == 1 !
  136.     case '(':
  137.         UPDATE (I);
  138.         c->BlockIndent = C;
  139.         CALL   (BLOCK, C + CONFIG.Block_Level);
  140.         break;
  141.  
  142.     case ')':
  143.         Error (c, UNMATCHED_BRACE_ERROR);
  144.         return;
  145.  
  146.     case ';':
  147.         if (BOL)
  148.         {
  149.         if (C == 0)
  150.             INDENT (0);
  151.         else
  152.             INDENT (I+CONFIG.Comment_Level);
  153.         }
  154.         else
  155.         INDENT (CONFIG.LineComment_Abs);
  156.         CALL (COMMENT, C);
  157.         break;
  158.  
  159.     default:
  160.         Error (c, SYNTAX_ERROR);
  161.     }
  162.     }
  163. }
  164.  
  165. /*))*/
  166. /*(( "BLOCK ()" */
  167.  
  168. FUNC (BLOCK)
  169. {
  170.     int argnr = 0, lastlevel;
  171.     debug (D_PARSER, ("BLOCK(%ld)\t", I));
  172.     dcheck;
  173.  
  174.     lastlevel = c->BlockIndent;
  175.  
  176.     DOGET
  177.     {
  178.     PEEK;
  179.     if (P[0] == ';')
  180.         SETEOL;
  181.     switch (W[0]) {                 // no test for length == 1 !
  182.     case '(':
  183.         INDENT (I);
  184.         switch (argnr++) {
  185.         case 0:
  186.         case 1:
  187.         I = C;
  188.         }
  189.         c->BlockIndent = C;
  190.         CALL   (BLOCK, C + CONFIG.Block_Level);
  191.         c->BlockIndent = lastlevel;
  192.         break;
  193.  
  194.     case ')':
  195.         INDENT (lastlevel);
  196.         return;
  197.  
  198.     case ';':
  199.         if (BOL)
  200.         {
  201.         if (C == 0)
  202.             INDENT (0);
  203.         else
  204.             INDENT (I+CONFIG.Comment_Level);
  205.         }
  206.         else
  207.         INDENT (CONFIG.LineComment_Abs);
  208.         CALL (COMMENT, C);
  209.         break;
  210.  
  211.     case '"':
  212.         switch (argnr++) {
  213.         case 0:
  214.         Error (c, FUNCTION_AFTER_BRACE_EXPECTED_ERROR);
  215.         break;
  216.         case 1:
  217.         UPDATE (I);
  218.         break;
  219.         default:
  220.         INDENT (I);
  221.         }
  222.         CALL (STRING_DOUBLE, C+1);
  223.         break;
  224.  
  225.     case '\'':
  226.         switch (argnr++) {
  227.         case 0:
  228.         Error (c, FUNCTION_AFTER_BRACE_EXPECTED_ERROR);
  229.         break;
  230.         case 1:
  231.         UPDATE (I);
  232.         break;
  233.         default:
  234.         INDENT (I);
  235.         }
  236.         CALL (STRING_SINGLE, C+1);
  237.         break;
  238.  
  239.     default:
  240.         switch (argnr++) {
  241.         case 0:
  242.         INDENT (I);
  243.         I = N;
  244.         break;
  245.         case 1:
  246.         UPDATE (I);
  247.         break;
  248.         default:
  249.         INDENT (I);
  250.         }
  251.  
  252.     }
  253.     }
  254. }
  255.  
  256. /*)) */
  257. /*(( "COMMENT ()" */
  258.  
  259. FUNC (COMMENT)
  260. {
  261.     debug (D_PARSER, ("COMMENT(%ld)\t", I));
  262.     dcheck;
  263.  
  264.     GET;
  265.     while (*W == ';')
  266.     {
  267.     I = C;
  268.     GET;
  269.     }
  270.     INDENT (I + 2);
  271.     UNGET;
  272.  
  273.     DOGET
  274.     {
  275.     if (EOL)
  276.         return;
  277.     }
  278. }
  279.  
  280. /*)) */
  281. /*(( "STRING_SINGLE ()" */
  282.  
  283. FUNC (STRING_SINGLE)
  284. {
  285.     debug (D_PARSER, ("STRING_SINGLE(%ld)\t", I));
  286.     dcheck;
  287.  
  288.     if (EOL)
  289.     ERROR (STRING_TERMINATION_ERROR);
  290.  
  291.     DOGET
  292.     {
  293.     if (W[1] == 0)
  294.     {
  295.         switch (W[0]) {
  296.         case '\'':
  297.         return;
  298.  
  299.         case '\\':
  300.         GET;                    /* skip next char (may be ' or \ ) */
  301.         }
  302.     }
  303.     if (EOL)
  304.         ERROR (STRING_TERMINATION_ERROR);
  305.     }
  306. }
  307.  
  308. /*)) */
  309. /*(( "STRING_DOUBLE ()" */
  310.  
  311. FUNC (STRING_DOUBLE)
  312. {
  313.     debug (D_PARSER, ("STRING_DOUBLE(%ld)\t", I));
  314.     dcheck;
  315.  
  316.     if (EOL)
  317.     ERROR (STRING_TERMINATION_ERROR);
  318.  
  319.     DOGET
  320.     {
  321.     if (W[1] == 0)
  322.     {
  323.         switch (W[0]) {
  324.         case '"':
  325.         return;
  326.  
  327.         case '\\':
  328.         GET;                    /* skip next char (may be " or \ ) */
  329.         }
  330.     }
  331.     if (EOL)
  332.         ERROR (STRING_TERMINATION_ERROR);
  333.     }
  334. }
  335.  
  336. /*)) */
  337.  
  338.